Исходный код

Option Explicit
Call TestIconsCollection()


'==============================================================================
' Выполнить одно из выбранных пользователем действий над коллекцией файлов объекта
' (нужны права системного администратора).
'==============================================================================
Sub TestIconsCollection()
        
        Dim Icons, ico, SelDlg, RetVal, strAction, ArActions
        
        'Получить ссылку на коллекцию иконок приложения
        Set Icons = ThisApplication.Icons

        ArActions = Array("Добавить значок", "Удалить значок",_
                                                    "Вывести описание значка")
        
        'Предоставить пользователю выбрать действие 
        Set SelDlg = ThisApplication.Dialogs.SelectDlg
        SelDlg.SelectFrom = ArActions 
        SelDlg.Prompt = "Выберите действие:"
        RetVal = SelDlg.Show
        
        'Если пользователь отменил диалог или ничего не выбрал, закончить работу.
        'Диалог вернул массив, поскольку был инициализирован строковым массивом
        If (RetVal <> TRUE) Or (UBound(SelDlg.Objects)<0) Then Exit Sub
        
        'Выполнить все заданные действия
        For Each strAction In SelDlg.Objects
                If StrComp(strAction, ArActions(0))=0 Then
                                                                                        Call AddIco(Icons)
                ElseIf StrComp(strAction, ArActions(1))=0 Then
                                                                                        Call RemoveIco(Icons)
                ElseIf StrComp(strAction, ArActions(2))=0 Then
                                                                                        Call ShowInfo(Icons)
                End If
        Next

End Sub
'==============================================================================
    
    
'==============================================================================
'Добавить иконку в коллекцию приложения
'==============================================================================
Sub AddIco(Icons)
        Dim SelFileDlg, NewIcon, RetVal 
        
        ' Открыть диалог выбора файлов, задав фильтр *.ico
        Set SelFileDlg = ThisApplication.Dialogs.FileDlg
        SelFileDlg.Filter = "Файлы иконок (*.ico)|*.ico||"
        RetVal = SelFileDlg.Show
        
        If RetVal Then
                'Создать новый объект TDMSIcon
                Set NewIcon = ThisApplication.Icons.Create
                NewIcon.Description = "Test icon"
                NewIcon.SysName = "IMG_TEST"
                
                'Загрузить значок из файла
                NewIcon.LoadIcon SelFileDlg.FileName
        End If
End Sub
'==============================================================================

'==============================================================================
'Удалить иконку из коллекции приложения
'==============================================================================
Sub RemoveIco(Icons)
        Dim StrRet, index 
        
        If Icons.Count=0 Then
                MsgBox "В приложении нет значков, загруженных пользователями.", vbInformation
                Exit Sub
        End If
        
        'Запросить индекс значка для удаления. Он не должен превышать количество 
        'пользовательских значков в приложении
        StrRet = InputBox("Введите индекс пользовательского значка для удаления" & Chr(13) &_
                         "(от 0 до " & Icons.Count-1 & "):")
        
        'Если введено не-число или диалог отменен, выйти из процедуры
        If (StrRet="") Or (Not IsNumeric(StrRet)) Then Exit Sub
        
        'Получить введенный индекс
        index = CLng(StrRet)
        
        'Возможно, введенное число выходит за границы допустимого диапазона
        If Not Icons.Has(index) Then
                MsgBox "Задан недопустимый индекс.", vbExclamation
                Exit Sub
        End If
        
        'Отключить обработку ошибок (они могут возникнуть при удалении значка)
        On Error Resume Next
        
        'Попытаться удалить значок
        Icons.Remove Icons.Item(index)
        
        'Если ошибка все-таки была, скорее всего это потому что значок используется.
        If Err<>0 Then
                MsgBox "Ошибка удаления значка (возможно, он используется каким-либо объектом.)", _
                                    vbExclamation
        End If
        
End Sub
'==============================================================================

'==============================================================================
'Вывести информацию о значке с заданным индексом
'==============================================================================
Sub ShowInfo(Icons)
        Dim StrRet, index, ico, StrInfo
        
        If Icons.Count=0 Then
                MsgBox "В приложении нет значков, загруженных пользователями.", vbInformation
                Exit Sub
        End If
        
        'Запросить индекс значка. Он не должен превышать количество 
        'пользовательских значков в приложении
        StrRet = InputBox("Введите индекс пользовательского значка" & Chr(13) &_
                         "(от 0 до " & Icons.Count-1 & "):")
        
        'Если введено не-число или диалог отменен, выйти из процедуры
        If (StrRet="") Or (Not IsNumeric(StrRet)) Then Exit Sub
        
        'Получить введенный индекс
        index = CLng(StrRet)
        
        'Возможно, введенное число выходит за границы допустимого диапазона
        If Not Icons.Has(index) Then
                MsgBox "Задан недопустимый индекс.", vbExclamation
                Exit Sub
        End If
        
        'Получить ссылку на значок из коллекции
        Set ico = Icons.Item(index)
        
        'Сформировать строку с информацией
        StrInfo = "Значок под номером " & index+1 & Chr(13)
        StrInfo = StrInfo & "Описание: " &  ico.Description & Chr(13)
        StrInfo = StrInfo & "Системное имя: " &  ico.SysName & Chr(13)
        StrInfo = StrInfo & "Дескриптор: " &  ico.Handle & Chr(13)
        StrInfo = StrInfo & "Системный?: " &  ico.System & Chr(13)
        StrInfo = StrInfo & "Строковое представление: " &  ico.IconAsString
        
        'Вывести информацию о значке в окно сообщений
        ThisApplication.AddNotify StrInfo 
End Sub
'==============================================================================